home *** CD-ROM | disk | FTP | other *** search
/ BCI NET / BCI NET Dec 94.iso / archives / programming / languages / cleo.lzh / Cleo / source / PASLIB.C < prev    next >
Encoding:
C/C++ Source or Header  |  1993-01-24  |  5.8 KB  |  225 lines

  1. /***************************************************************************
  2. *   Ce fichier, ainsi que tous les  modules  l'accompagnant, peut et  doit *
  3. * etre  copié GRATUITEMENT à la seule condition expresse de conserver      *
  4. * l'INTEGRALITE  du  Code Source, de  la documentation, et  des fichiers   *
  5. * annexes du package. Ce logiciel est Shareware, veuilez envoyer 100 FF à  *
  6. * l'auteur pour recevoir regulièrement les nouvelles versions.             *
  7. * Toute modification est INTERDITE sans l'autorisation écrite de l'auteur. *
  8. *            Tous droits réservés à M. DIALLO Barrou, Juillet 1992.        *
  9. ***************************************************************************/
  10.  
  11.         /*************** Librarie de fonctions Pascal *****************/
  12.  
  13. #ifdef msdos
  14.         #include "include\\cleobis.h"
  15.         #include "include\\libs.h"
  16. #else
  17.         #include "include/cleobis.h"
  18.         #include "include/libs.h"
  19. #endif
  20.  
  21. extern void TraitErreur (char type, int num, int lig, int col);
  22. extern int curlg;
  23. extern int curcol;
  24. extern char curtoken[];
  25. extern CONST *symb;
  26. extern CONST *cursymb;
  27. extern VAR *var;
  28. extern VAR *curvar;
  29. extern int NbVar;
  30. extern MY_TYPESID curtokentype;
  31. extern MY_TYPESID lasttokentype;
  32. extern MY_TYPESID facttype;
  33. extern MY_CONST curconst;
  34. extern Entete head;
  35. extern int curtokenid;
  36. extern int lasttokenid;
  37. extern int curadr;
  38. extern long AdressSize;
  39. extern int *Adress;
  40. extern int pcpc;
  41. extern FIELDSTRUCT Field[];
  42.  
  43. void NewAdress(void)
  44. {
  45.         if (curadr == AdressSize)
  46.                 TraitErreur(FATALERROR, NOADRSPC, curlg, curcol);
  47.         else
  48.                 curadr++;
  49. }
  50.  
  51. void while_fct(void)
  52. {
  53.         int adress, adress1;
  54.  
  55.         NewAdress();
  56.         adress = curadr;
  57.         Code (ORG, adress);   /* Stocke l'adr du debut du while */
  58.         Lexical();
  59.         Expr();
  60.         NewAdress();
  61.         adress1 = curadr;
  62.         Code ( BNE, adress1);
  63.         if ( curtokenid == do_f)
  64.             {
  65.             Lexical();
  66.             Instruction();
  67.             Code ( BRA, adress);
  68.             Code (ORG, adress1); /* La fin du while (adress1)
  69.                                   est egal au PC apres l'instruction */
  70.             }
  71.         else
  72.             TraitErreur(TEXTERROR, NODO, curlg, curcol);
  73. }
  74.  
  75. void for_fct(void)
  76. {
  77.     int adress;
  78.         NewAdress();
  79.         adress = curadr;
  80.         Code (ORG, adress);
  81.         Lexical();
  82.  
  83. }
  84.  
  85. void repeat_fct(void)
  86. {
  87.         int adress;
  88.  
  89.         NewAdress();
  90.         adress = curadr;
  91.         Code (ORG, adress);
  92.         do {
  93.             Lexical();
  94.             Instruction();
  95.         } while ( *curtoken == ';');
  96.  
  97.         if (curtokenid != until_f)
  98.             TraitErreur (TEXTERROR, NOUNTIL, curlg, curcol);
  99.         else
  100.             {
  101.                 Lexical();
  102.                 Expr();
  103.             }
  104.         Code( BNE, adress);
  105. }
  106.  
  107. void PokeAdr(int adress)
  108. {
  109.     Adress[adress] = pcpc;
  110. }
  111.  
  112. void if_fct(void)
  113. {
  114.         int adress1, adress;
  115.  
  116.         Lexical();
  117.         Expr();
  118.         NewAdress();
  119.         adress = curadr;
  120.         Code ( BNE, adress);
  121.         if (curtokenid != then_f)
  122.                 TraitErreur (TEXTERROR, NOTHEN, curlg, curcol);
  123.         else
  124.             {
  125.                 Lexical();
  126.                 Instruction();
  127.  
  128.                 if ( *curtoken == ';') PokeAdr( adress);
  129.                 else
  130.                 {
  131.                     if ( curtokenid == else_f)
  132.                         {
  133.                             NewAdress();
  134.                             adress1 = curadr;
  135.                             Code ( BRA, adress1);
  136.                             Code (ORG, adress);
  137.                             Lexical();
  138.                             Instruction();
  139.                             Code ( ORG, adress1);
  140.                         }
  141.                     else
  142.                         printf("ELSE Manquant...\n");
  143.                }
  144.           }
  145. }
  146.  
  147. void read_fct(void)
  148. {
  149.         if ( *curtoken != '(' )
  150.                 TraitErreur ( TEXTERROR, NOPO, curlg, curcol);
  151.         else
  152.         do {
  153.                 Lexical();
  154.                 if ( curtokentype != ident_mt)
  155.                         TraitErreur (TEXTERROR, NOIDENT, curlg, curcol);
  156.                 else
  157.                 {
  158.                    TestVar(FALSE);
  159.                    Code (READ, 0);
  160.                 }
  161.         } while ( *curtoken == ',');
  162.  
  163.         if ( *curtoken != ')' )
  164.             TraitErreur (TEXTERROR, NOPF, curlg, curcol);
  165.         else
  166.             Lexical();
  167. }
  168.  
  169. void readln_fct(void)
  170. {
  171.         Lexical();
  172.         if ( *curtoken == '(' )
  173.                 read_fct();
  174.         Code ( CHR13, 0);
  175. }
  176.  
  177. void writeln_fct (void)
  178. {
  179.         Lexical();
  180.         if ( *curtoken == '(' )
  181.                 write_fct();
  182.         Code( CHR13, 0);
  183. }
  184.  
  185. void write_fct(void)
  186. {
  187.         if ( *curtoken != '(' )
  188.                 TraitErreur (TEXTERROR, NOPO, curlg, curcol);
  189.         else
  190.           {
  191.            do {
  192.              Lexical();
  193.              if ( curtokentype == constchr_mt || curtokentype == conststr_mt )
  194.                {
  195.                  InsConst();
  196.                  if (lasttokentype == constchr_mt)
  197.                   {
  198.                     Code ( PRCHR, 0);   /* print la const chr sur la pile */
  199.                   }
  200.                  else
  201.                   {
  202.                    Code ( PRSTR,0);   /* print la String sur la pile */
  203.                   }
  204.               }
  205.              else
  206.                {
  207.                 Simple_Exp();
  208.                 /*** ATTENTION, on ne connait pas le type de la valeur !!!!! */
  209.                if (facttype == string_t)
  210.                    Code ( PRVSTR, 0);
  211.                else
  212.                if (facttype == char_t)
  213.                    Code ( PRINTCHR, 0);
  214.                else
  215.                 Code ( PRINT, 0);       /* affiche la valeur sur la pile */
  216.                }
  217.        } while ( *curtoken == ',' );
  218.  
  219.           if ( *curtoken != ')' )
  220.                 TraitErreur ( TEXTERROR, NOPF, curlg, curcol);
  221.           else
  222.             Lexical();
  223.     }
  224. }
  225.